(FILECREATED "31-OCT-73  3:07:36" S-EXAMPLE)


  (LISPXPRINT (QUOTE EXAMPLEVARS)
              T)
  (RPAQQ EXAMPLEVARS
         ((* Stuff for doing examples - Again, this needs work. 
             Problems are vagaries of UNDONLSETQ's, and the use of 
             ADVISE by EXAMPLE to select how to selectively turn things 
             off)
          (FNS EXAMPLE SELECT SELECTL SELECTLL EDGES EXAMPLELLABELNODES 
               EXAMPLELABELFV EXAMPLELABELEDGES 1ATRAND SPLIT)
          (VARS (EXAMPLEFIXED))
          (USERMACROS RX X DE)))

(* Stuff for doing examples - Again, this needs work. Problems are
vagaries of UNDONLSETQ's, and the use of ADVISE by EXAMPLE to select
how to selectively turn things off)

(DEFINEQ

(EXAMPLE
  [LAMBDA (X)
    (COND
      ((STRUCTURE? X)
        X)
      [(STRUCLIST? X)
        (EXAMPLE (1ATRAND (CDDR X]
      ((NOFORMIN X)
        X)
      (EXAMPLEFIXED (PROG (Y)
                          (EDITE X (QUOTE (RX)))
                          (SETQ Y (GENAPPLY X FIXEDFNLIST))
                          [COND
                            ((NOT (EQUAL X Y))
                              (SETQ Y (EXAMPLE Y]
                          (RETURN Y)))
      (T (UNDONLSETQ (PROG (Y (EXAMPLEFIXED T))
                           [ADVISE [OR (GETP (CAR (FETCH FORM OF X))
                                             (QUOTE DESCENDANTS))
                                       (UNION (CAR (FETCH FORM OF X))
                                              (QUOTE (
SUPERATOMPARTITIONS MOLECULES SUPERATOMS RINGS RINGSKELETONS NOFVRINGS 
                    DAISIES NUMPARTITIONS BIVALENTPARTITIONS 
                    KLOOPEDRINGS PERMRADS GENMOL]
                                   (QUOTE AFTER)
                                   (QUOTE (RETURN (LIST (1ATRAND !VALUE]
                           [ADVISE (QUOTE LABELEDGES)
                                   (QUOTE BEFORE)
                                   (QUOTE (RETURN (EXAMPLELABELEDGES
                                                    STRUC LABELS]
                           [ADVISE (QUOTE LABELFV)
                                   (QUOTE BEFORE)
                                   (QUOTE (RETURN (EXAMPLELABELFV
                                                    STRUC LABELS]
                           [ADVISE (QUOTE LLABELNODES)
                                   (QUOTE BEFORE)
                                   (QUOTE (RETURN (EXAMPLELLABELNODES
                                                    STRUC LLABELS]
                           [SETQ X (CONS (QUOTE DONE)
                                         (COPY (EXAMPLE X]
                           (ERROR!)))
         (COND
           ((EQ (CAR X)
                (QUOTE DONE))
             (CDR X))
           (T (ERROR!])

(SELECT
  [LAMBDA (L N)
    (NLEFT L N])

(SELECTL
  [LAMBDA (OBJ LNUM)
    (PROG (X)
          (AND LNUM (CONS [CAR (SETQ X (SPLIT OBJ (CAR LNUM]
                          (SELECTL (CDR X)
                                   (CDR LNUM])

(SELECTLL
  [LAMBDA (LOBJ LLNUM)
    (AND LOBJ LLNUM (CONS (SELECTL (CAR LOBJ)
                                   (CAR LLNUM))
                          (SELECTLL (CDR LOBJ)
                                    (CDR LLNUM])

(EDGES
  [LAMBDA (STRUC)
    (FOR CT IN (fetch CTABLE of STRUC) FOR N
       IN (fetch NBRS of CT)
       WHEN (NOT (IGREATERP (fetch NODENUM of CT)
                            N))
            XLIST
            (CONS (fetch NODENUM of CT)
                  N])

(EXAMPLELLABELNODES
  [LAMBDA (STRUC LLABELS)
    (LIST (create LABELING LABELED←(SELECTLL (LISTBYVALENCE STRUC)
                                             LLABELS)
                  LSTRUC←(create STRUCTURE reusing STRUC (SETQ GROUP 
                                                     NIL])

(EXAMPLELABELFV
  [LAMBDA (STRUC LABELS)
    (LIST (create LABELING (SETQ LABELED (SELECTL (COLLECTFV STRUC)
                                                  LABELS))
                  LABELS
                  (SETQ LSTRUC (create STRUCTURE reusing STRUC GROUP← 
                                                         NIL])

(EXAMPLELABELEDGES
  [LAMBDA (STRUC LABELS)
    (LIST (create LABELING LABELED←(SELECTL (EDGES STRUC)
                                            LABELS)
                  LSTRUC←(create STRUCTURE reusing STRUC GROUP← NIL])

(1ATRAND
  [LAMBDA (L)
    (CAR (NTH L (RAND 1 (LENGTH L])

(SPLIT
  [LAMBDA (L N)

          (* Returns a pair of lists, 
          (l1 . l2) WHERE l1 is a list of elements of L, of 
          length N, and l2 is the REMAINDER)


    (COND
      ((NULL L)
        (LIST NIL))
      ((ZEROP N)
        (CONS NIL L))
      ((EQ N (LENGTH L))
        (LIST L))
      [(NOT (IGREATERP (RAND 1 (LENGTH L))
                       N))
        ([LAMBDA (Z)
            (RPLACA Z (CONS (CAR L)
                            (CAR Z]
          (SPLIT (CDR L)
                 (SUB1 N]
      (T ([LAMBDA (Z)
             (RPLACD Z (CONS (CAR L)
                             (CDR Z]
           (SPLIT (CDR L)
                  N])
)
  (RPAQ EXAMPLEFIXED)
  [ADDTOVAR USERMACROS (RX NIL MARK
                           [LCL (LPQ F STRUCFORM UP
                                     (I 1 (EXAMPLE (## 1]
                           ←←)
            (X NIL RX UP (I 1 (EXAMPLE (## 1)))
               1)
            (DE NIL (ORR ((E (DRAW (EXAMPLE (##))
                                   T)
                             T))
                         (E (QUOTE (can't draw]
  (ADDTOVAR EDITCOMSA DE X RX)
STOP